home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Peter Lewis / PNL Libraries / StandardGetFolder.p < prev    next >
Encoding:
Text File  |  1994-08-27  |  11.3 KB  |  276 lines  |  [TEXT/PJMM]
  1. {******************************************************************************}
  2. { StandardGetFolder.c                                                          }
  3. {                                                                              }
  4. {    This little chunk o' code implements a way to let the user choose a       }
  5. {    folder to save files in via a StandardFile Dialog.                        }
  6. {                                                                              }
  7. {    Since the code uses the CustomGetFile function and depends on the use of  }
  8. {    FSSpec records, it only works under System 7.0 or later.                  }
  9. {                                                                              }
  10. {    And don't forget to include the custom dialog resources ( a 'DITL' and    }
  11. {   'DLOG') in your project.                                                   }
  12. {                                                                              }
  13. {    Portions of this code were originally provided by Paul Forrester          }
  14. {    (paulf@apple.com) to the think-c internet mailing list in response to my  }
  15. {    my question on how to do exactly what this code does.  I've added a       }
  16. {    couple of features, such as the ability to handle aliased folders and     }
  17. {    the programmer definable prompt.  I also cleaned and tightened the code,  }
  18. {    stomped a couple of bugs, and packaged it up neatly.  Bunches of work,    }
  19. {    but I learned A LOT about Standard File, the File Manager, the Dialog     }
  20. {    Manager, and the Alias Manager.  I tried to include in the comments some  }
  21. {    of the neat stuff I discovered in my hours of pouring over Inside Mac.    }
  22. {    Hope you find it educational as well as useful.                           }
  23. {******************************************************************************}
  24. { Converted to Pascal by Peter N Lewis <peter.lewis@info.curtin.edu.au> Dec 1992 }
  25.  
  26. unit StandardGetFolder;
  27.  
  28. interface
  29.  
  30.     procedure GetSFLocation (var vrn: integer; var dirID: longInt);
  31.     procedure SetSFLocation (vrn: integer; dirID: longInt);
  32.     procedure StandardGetFolder (where: Point; message: Str255; var mySFReply: StandardFileReply);
  33.  
  34. implementation
  35.  
  36.     uses
  37.         Aliases, Script;
  38.  
  39. { Resource IDs }
  40.     const
  41.         rGetFolderButton = 10;
  42.         rGetFolderMessage = 11;
  43.         rGetFolderSelectString = 12;
  44.         kFolderBit = $0010;
  45.         rGetFolderDialog = 2008;
  46.  
  47. { Global Variables }
  48.  
  49.     var
  50.         gCurrentSelectedFolder: str255;
  51.  
  52.     const
  53.         SFSaveDiskA = $214;
  54.         CurDirStoreA = $398;
  55.     type
  56.         intPtr = ^integer;
  57.         longPtr = ^longInt;
  58.  
  59. { The following set of routines are used to access a couple of low memory      }
  60. { globals that are necessary when extending Standard File.  One example is     }
  61. { trying to get the current directory while in a file filter.  These routines  }
  62. { were used to bottleneck all the low memory usage.  If the system one day     }
  63. { supports them with a trap call, then we can easily update these routines.    }
  64.  
  65.     procedure GetSFLocation (var vrn: integer; var dirID: longInt);
  66.     begin
  67.         vrn := -intPtr(SFSaveDiskA)^;
  68.         dirID := longPtr(CurDirStoreA)^;
  69.     end;
  70.  
  71.     procedure SetSFLocation (vrn: integer; dirID: longInt);
  72.     begin
  73.         intPtr(SFSaveDiskA)^ := -vrn;
  74.         longPtr(CurDirStoreA)^ := dirID;
  75.     end;
  76.  
  77. {******************************************************************************}
  78. { MyCustomGetDirectoryFileFilter                                               }
  79. {                                                                              }
  80. {     This is the file filter passed to CustomGetFile. It passes folders only. }
  81. {******************************************************************************}
  82.     function MyCustomGetDirectoryFileFilter (var myPB: CInfoPBRec; myDataPtr: Ptr): boolean;
  83.     begin
  84.         MyCustomGetDirectoryFileFilter := BAND(myPB.ioFlAttrib, kFolderBit) = 0;
  85.     end;
  86.  
  87.  
  88. {******************************************************************************}
  89. { MyCustomGetDirectoryDlogHook                                                 }
  90. {                                                                              }
  91. {     This function lets us process item hits in the GetFolderDialog.  We're   }
  92. {     only interested if the user hit the selectFolder button. We pass all     }
  93. {     other item hits back to ModalDialog.                                     }
  94. {******************************************************************************}
  95.  
  96.     function MyCustomGetDirectoryDlogHook (item: integer; theDialog: DialogPtr; myDataPtr: Ptr): integer;
  97.  
  98.         procedure SetButtonTitle (name: Str255);
  99.             var
  100.                 resultCode: integer;
  101.                 width: integer;
  102.                 TmpStr, left, right: str255;
  103.                 itemType: integer;
  104.                 itemHandle: handle;
  105.                 itemRect: rect;
  106.                 p: integer;
  107.         begin
  108.             if gCurrentSelectedFolder <> name then begin
  109.                 GetDItem(theDialog, rGetFolderSelectString, itemType, itemHandle, itemRect);
  110.                 GetIText(itemHandle, TmpStr);
  111.                 p := Pos('^1', TmpStr);
  112.                 left := copy(TmpStr, 1, p - 1);
  113.                 right := copy(TmpStr, p + 2, 255);
  114.                 GetDItem(theDialog, rGetFolderButton, itemType, itemHandle, itemRect);
  115.                 gCurrentSelectedFolder := name;
  116.  
  117.     {*-------------------------------------------------------------------------}
  118.     { Find the width left over in the button after drawing the word 'Select'   }
  119.     { the quotation marks. Truncate the new name to this length.               }
  120.     {-------------------------------------------------------------------------*}
  121.                 width := (itemRect.right - itemRect.left) - StringWidth(concat(' ', left, right, ' '));
  122.  
  123.                 resultCode := TruncString(width, name, smTruncEnd);
  124.                 if resultCode < 0 then
  125.                     ;
  126.  
  127.                 TmpStr := concat(left, name, right);
  128.                 SetCTitle(ControlHandle(itemHandle), TmpStr);
  129.                 ValidRect(itemRect);
  130.             end;
  131.         end;
  132.  
  133.         procedure SetFolderButtonTitle (vrn: integer; dirID: longInt);
  134.             var
  135.                 name: str63;
  136.                 pb: CInfoPBRec;
  137.                 oe: OSErr;
  138.         begin
  139.             pb.ioNamePtr := @name;
  140.             pb.ioVRefNum := vrn;
  141.             pb.ioDirID := dirID;
  142.             pb.ioFDirIndex := -1;
  143.             oe := PBGetCatInfoSync(@pb);
  144.  
  145.             if oe = noErr then begin
  146.                 SetButtonTitle(name);
  147.             end;
  148.         end;
  149.  
  150.         type
  151.             StandardFileReplyPtr = ^StandardFileReply;
  152.         var
  153.             pb: CInfoPBRec;
  154.             err: OSErr;
  155.             itemType: integer;
  156.             itemRect: Rect;
  157.             itemHandle: Handle;
  158.             mySFRPtr: StandardFileReplyPtr;
  159.     begin
  160.  
  161.     {*-------------------------------------------------------------------------}
  162.     { CustomGet calls dialog hook for both main and subsidiary dialog boxes.   }
  163.     { Make sure that dialog record indicates that this is the main GetFolder   }
  164.     { dialog.                                                                  }
  165.     {-------------------------------------------------------------------------*}
  166.         if OSType(WindowPeek(theDialog)^.refCon) = sfMainDialogRefCon then begin
  167.  
  168.             mySFRPtr := StandardFileReplyPtr(myDataPtr);
  169.  
  170.             if item = sfHookFirstCall then begin
  171.  
  172.             {*-----------------------------------------------------------------}
  173.             { Set the prompt displayed above the file list...                  }
  174.             {-----------------------------------------------------------------*}
  175.                 GetDItem(theDialog, rGetFolderMessage, itemType, itemHandle, itemRect);
  176.                 SetIText(itemHandle, gCurrentSelectedFolder);
  177.                 gCurrentSelectedFolder := '';
  178.  
  179.             end
  180.             else begin
  181. {    DebugStr(StringOf(ord(mySFRPtr^.sfIsFolder) <> 0, '"', mySFRPtr^.sfFile.name, '"', ';g'));}
  182.                 if (mySFRPtr^.sfFile.name = '') then begin
  183.                     GetSFLocation(mySFRPtr^.sfFile.vRefNum, mySFRPtr^.sfFile.parID); { these aren't always set properly }
  184.                     mySFRPtr^.sfFile.name := '';
  185.                     SetFolderButtonTitle(mySFRPtr^.sfFile.vRefNum, mySFRPtr^.sfFile.parID);
  186.                 end
  187.                 else begin
  188.                     SetButtonTitle(mySFRPtr^.sfFile.name);
  189.                 end;
  190.             end;
  191.  
  192.             if item = rGetFolderButton then begin
  193.                 item := sfItemCancelButton;
  194.                 mySFRPtr^.sfGood := true;
  195.             end;
  196.  
  197.         end;
  198.         MyCustomGetDirectoryDlogHook := item;
  199.     end;
  200.  
  201.  
  202. {******************************************************************************}
  203. { StandardGetFolder                                                            }
  204. {                                                                              }
  205. {     The StandardGetFolder function. You pass it the point where you want the }
  206. {     standard file dialog box drawn, the prompt to display above the file     }
  207. {     list, and a pointer to an StandardFileReply record.                      }
  208. {                                                                              }
  209. {     Upon return, the sfFile field of the SFReply record contains the volume  }
  210. {     reference number and directory ID that specify the folder the user       }
  211. {     chose. It also passes back the name of the chosen folder.  The sfGood    }
  212. {     field is set to true if the user chose a folder, or false if not.        }
  213. {******************************************************************************}
  214.  
  215.     procedure StandardGetFolder (where: Point; message: Str255; var mySFReply: StandardFileReply);
  216.         var
  217.             theTypeList: SFTypeList;
  218.             myModalFilter: ProcPtr;
  219.             pb: CInfoPBRec;
  220.             err: OSErr;
  221.             theItem: integer;
  222.             isfolder, wasaliased: boolean;
  223.             oe: OSErr;
  224.             fs: FSSpec;
  225.     begin
  226.     {*-------------------------------------------------------------------------}
  227.     { Copy the prompt to be displayed above the file list into gCurrentSelectedFolder  }
  228.     { When MyCustomGetDirectoryDlogHook is called for   }
  229.     { the first time, it will use this info to draw the prompt.                }
  230.     {-------------------------------------------------------------------------*}
  231.         gCurrentSelectedFolder := message;
  232.  
  233.     {*-------------------------------------------------------------------------}
  234.     { Call CustomGetFile. Pass it a pointer to the file filter and dialog      }
  235.     { hook functions. Also pass a pointer to mySFReply in the user data field. }
  236.     {-------------------------------------------------------------------------*}
  237.         CustomGetFile(@MyCustomGetDirectoryFileFilter, -1, theTypeList, mySFReply, rGetFolderDialog, where, @MyCustomGetDirectoryDlogHook, nil, nil, nil, @mySFReply);
  238.  
  239.     {*-------------------------------------------------------------------------}
  240.     { Ok, now the reply record contains the volume reference number and the    }
  241.     { name of the selected folder. We need to use PBGetCatInfo to get the      }
  242.     { directory ID of the selected folder.                                     }
  243.     {-------------------------------------------------------------------------*}
  244.         if mySFReply.sfGood then begin { Don't call PBGetCatInfo on cancel! }
  245.  
  246.             if mySFReply.sfFile.name <> '' then begin
  247.                 oe := ResolveAliasFile(mySFReply.sfFile, true, isfolder, wasaliased);
  248.                 if (oe = noErr) & not isfolder then
  249.                     DebugStr('Not folder?');
  250.                 if oe = noErr then begin
  251.                     pb.ioVRefNum := mySFReply.sfFile.vRefNum;
  252.                     pb.ioDirID := mySFReply.sfFile.parID;
  253.                     pb.ioNamePtr := @mySFReply.sfFile.name;
  254.                     pb.ioFDirIndex := 0;
  255.  
  256.                     oe := PBGetCatInfoSync(@pb);
  257.                 end;
  258.                 mySFReply.sfGood := oe = noErr;
  259.  
  260.                 mySFReply.sfFile.parID := pb.ioDrDirID;
  261.                 mySFReply.sfFile.name := '';
  262.             end;
  263. {    DebugStr(StringOf(oe, mySFReply.sfGood, mySFReply.sfFile.vRefNum, mySFReply.sfFile.parID, ';g'));}
  264.             if oe = noErr then begin
  265.                 pb.ioVRefNum := mySFReply.sfFile.vRefNum;
  266.                 pb.ioDirID := mySFReply.sfFile.parID;
  267.                 pb.ioNamePtr := @mySFReply.sfFile.name;
  268.                 pb.ioFDirIndex := -1;
  269.                 oe := PBGetCatInfoSync(@pb);
  270.             end;
  271. {    DebugStr(StringOf(oe, mySFReply.sfFile.vRefNum, mySFReply.sfFile.parID, '"', mySFReply.sfFile.name, '"', ';g'));}
  272.         end;
  273.  
  274.     end;
  275.  
  276. end.